home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Mega Archive 1
/
Atari Mega Archive - Volume 1.iso
/
gnu
/
emacs
/
emacs1857
/
bin_d2.zoo
/
lisp
/
info.el
< prev
next >
Wrap
Lisp/Scheme
|
1991-12-02
|
24KB
|
702 lines
;; Info package for Emacs -- could use a "create node" feature.
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(provide 'info)
(defvar Info-history nil
"List of info nodes user has visited.
Each element of list is a list (FILENAME NODENAME BUFFERPOS).")
(defvar Info-enable-edit nil
"Non-nil means the \\[Info-edit] command in Info can edit the current node.")
(defvar Info-enable-active-nodes t
"Non-nil allows Info to execute Lisp code associated with nodes.
The Lisp code is executed when the node is selected.")
(defvar Info-directory nil
"Default directory for Info documentation files.")
(defvar Info-current-file nil
"Info file that Info is now looking at, or nil.")
(defvar Info-current-subfile nil
"Info subfile that is actually in the *info* buffer now,
or nil if current info file is not split into subfiles.")
(defvar Info-current-node nil
"Name of node that Info is now looking at, or nil.")
(defvar Info-tag-table-marker (make-marker)
"Marker pointing at beginning of current Info file's tag table.
Marker points nowhere if file has no tag table.")
(defun info ()
"Enter Info, the documentation browser."
(interactive)
(if (get-buffer "*info*")
(switch-to-buffer "*info*")
(Info-directory)))
;; Go to an info node specified as separate filename and nodename.
;; no-going-back is non-nil if recovering from an error in this function;
;; it says do not attempt further (recursive) error recovery.
(defun Info-find-node (filename nodename &optional no-going-back)
;; Convert filename to lower case if not found as specified.
;; Expand it.
(if filename
(let (temp)
(setq filename (substitute-in-file-name filename))
(setq temp (expand-file-name filename
;; Use Info's default dir
;; unless the filename starts with `./'.
(if (not (string-match "^\\./" filename))
Info-directory)))
(if (file-exists-p temp)
(setq filename temp)
(setq temp (expand-file-name (downcase filename) Info-directory))
(if (file-exists-p temp)
(setq filename temp)
(error "Info file %s does not exist"
(expand-file-name filename Info-directory))))))
;; Record the node we are leaving.
(if (and Info-current-file (not no-going-back))
(setq Info-history
(cons (list Info-current-file Info-current-node (point))
Info-history)))
;; Go into info buffer.
(switch-to-buffer "*info*")
(or (eq major-mode 'Info-mode)
(Info-mode))
(widen)
(setq Info-current-node nil)
(unwind-protect
(progn
;; Switch files if necessary
(or (null filename)
(equal Info-current-file filename)
(let ((buffer-read-only nil))
(setq Info-current-file nil
Info-current-subfile nil)
(erase-buffer)
(insert-file-contents filename t)
(set-buffer-modified-p nil)
(setq default-directory (file-name-directory filename))
;; See whether file has a tag table. Record the location if yes.
(set-marker Info-tag-table-marker nil)
(goto-char (point-max))
(forward-line -8)
(or (equal nodename "*")
(not (search-forward "\^_\nEnd tag table\n" nil t))
(let (pos)
;; We have a tag table. Find its beginning.
;; Is this an indirect file?
(search-backward "\nTag table:\n")
(setq pos (point))
(if (save-excursion
(forward-line 2)
(looking-at "(Indirect)\n"))
;; It is indirect. Copy it to another buffer
;; and record that the tag table is in that buffer.
(save-excursion
(let ((buf (current-buffer)))
(set-buffer (get-buffer-create " *info tag table*"))
(setq case-fold-search t)
(erase-buffer)
(insert-buffer-substring buf)
(set-marker Info-tag-table-marker
(match-end 0))))
(set-marker Info-tag-table-marker pos))))
(setq Info-current-file
(file-name-sans-versions buffer-file-name))))
(if (equal nodename "*")
(progn (setq Info-current-node nodename)
(Info-set-mode-line))
;; Search file for a suitable node.
;; First get advice from tag table if file has one.
;; Also, if this is an indirect info file,
;; read the proper subfile into this buffer.
(let ((guesspos (point-min)))
(if (marker-position Info-tag-table-marker)
(save-excursion
(set-buffer (marker-buffer Info-tag-table-marker))
(goto-char Info-tag-table-marker)
(if (search-forward (concat "Node: " nodename "\177") nil t)
(progn
(setq guesspos (read (current-buffer)))
;; If this is an indirect file,
;; determine which file really holds this node
;; and read it in.
(if (not (eq (current-buffer) (get-buffer "*info*")))
(setq guesspos
(Info-read-subfile guesspos))))
(error "No such node: \"%s\"" nodename))))
(goto-char (max (point-min) (- guesspos 1000))))
;; Now search from our advised position (or from beg of buffer)
;; to find the actual node.
(let ((regexp (concat "Node: *" (regexp-quote nodename) " *[,\t\n]")))
(catch 'foo
(while (search-forward "\n\^_" nil t)
(forward-line 1)
(let ((beg (point)))
(forward-line 1)
(if (re-search-backward regexp beg t)
(throw 'foo t))))
(error "No such node: %s" nodename)))
(Info-select-node)))
;; If we did not finish finding the specified node,
;; go back to the previous one.
(or Info-current-node no-going-back
(let ((hist (car Info-history)))
(setq Info-history (cdr Info-history))
(Info-find-node (nth 0 hist) (nth 1 hist) t)
(goto-char (nth 2 hist)))))
(goto-char (point-min)))
(defun Info-read-subfile (nodepos)
(set-buffer (marker-buffer Info-tag-table-marker))
(goto-char (point-min))
(search-forward "\n\^_")
(let (lastfilepos
lastfilename)
(forward-line 2)
(catch 'foo
(while (not (looking-at "\^_"))
(if (not (eolp))
(let ((beg (point))
thisfilepos thisfilename)
(search-forward ": ")
(setq thisfilename (buffer-substring beg (- (point) 2)))
(setq thisfilepos (read (current-buffer)))
(if (> thisfilepos nodepos)
(throw 'foo t))
(setq lastfilename thisfilename)
(setq lastfilepos thisfilepos)))))
(set-buffer (get-buffer "*info*"))
(or (equal Info-current-subfile lastfilename)
(let ((buffer-read-only nil))
(setq buffer-file-name nil)
(widen)
(erase-buffer)
(insert-file-contents lastfilename)
(set-buffer-modified-p nil)
(setq Info-current-subfile lastfilename)))
(goto-char (point-min))
(search-forward "\n\^_")
(+ (- nodepos lastfilepos) (point))))
;; Select the info node that point is in.
(defun Info-select-node ()
(save-excursion
;; Find beginning of node.
(search-backward "\n\^_")
(forward-line 2)
;; Get nodename spelled as it is in the node.
(re-search-forward "Node:[ \t]*")
(setq Info-current-node
(buffer-substring (point)
(progn
(skip-chars-forward "^,\t\n")
(point))))
(Info-set-mode-line)
;; Find the end of it, and narrow.
(beginning-of-line)
(let (active-expression)
(narrow-to-region (point)
(if (re-search-forward "\n[\^_\f]" nil t)
(prog1
(1- (point))
(if (looking-at "[\n\^_\f]*execute: ")
(progn
(goto-char (match-end 0))
(setq active-expression
(read (current-buffer))))))
(point-max)))
(if Info-enable-active-nodes (eval active-expression)))))
(defun Info-set-mode-line ()
(setq mode